home *** CD-ROM | disk | FTP | other *** search
/ Atari Mega Archive 1 / Atari Mega Archive - Volume 1.iso / language / xlisp_21.zoo / xlpp.c < prev    next >
C/C++ Source or Header  |  1990-02-28  |  2KB  |  113 lines
  1. /* xlpp.c - xlisp pretty printer */
  2. /*    Copyright (c) 1985, by David Betz
  3.     All Rights Reserved            */
  4.  
  5. #include "xlisp.h"
  6.  
  7. /* external variables */
  8. extern LVAL s_stdout;
  9. extern int xlfsize;
  10.  
  11. /* local variables */
  12. static int pplevel,ppmargin,ppmaxlen;
  13. static LVAL ppfile;
  14.  
  15. /* xpp - pretty-print an expression */
  16. LVAL xpp()
  17. {
  18.     LVAL expr;
  19.  
  20.     /* get expression to print and file pointer */
  21.     expr = xlgetarg();
  22.     ppfile = (moreargs() ? xlgetfile() : getvalue(s_stdout));
  23.     xllastarg();
  24.  
  25.     /* pretty print the expression */
  26.     pplevel = ppmargin = 0; ppmaxlen = 40;
  27.     pp(expr); ppterpri(ppfile);
  28.  
  29.     /* return nil */
  30.     return (NIL);
  31. }
  32.  
  33. /* pp - pretty print an expression */
  34. LOCAL pp(expr)
  35.   LVAL expr;
  36. {
  37.     if (consp(expr))
  38.     pplist(expr);
  39.     else
  40.     ppexpr(expr);
  41. }
  42.  
  43. /* pplist - pretty print a list */
  44. LOCAL pplist(expr)
  45.   LVAL expr;
  46. {
  47.     int n;
  48.  
  49.     /* if the expression will fit on one line, print it on one */
  50.     if ((n = flatsize(expr)) < ppmaxlen) {
  51.     xlprint(ppfile,expr,TRUE);
  52.     pplevel += n;
  53.     }
  54.  
  55.     /* otherwise print it on several lines */
  56.     else {
  57.     n = ppmargin;
  58.     ppputc('(');
  59.     if (atom(car(expr))) {
  60.         ppexpr(car(expr));
  61.         ppputc(' ');
  62.         ppmargin = pplevel;
  63.         expr = cdr(expr);
  64.     }
  65.     else
  66.         ppmargin = pplevel;
  67.     for (; consp(expr); expr = cdr(expr)) {
  68.         pp(car(expr));
  69.         if (consp(cdr(expr)))
  70.         ppterpri();
  71.     }
  72.     if (expr != NIL) {
  73.         ppputc(' '); ppputc('.'); ppputc(' ');
  74.         ppexpr(expr);
  75.     }
  76.     ppputc(')');
  77.     ppmargin = n;
  78.     }
  79. }
  80.  
  81. /* ppexpr - print an expression and update the indent level */
  82. LOCAL ppexpr(expr)
  83.   LVAL expr;
  84. {
  85.     xlprint(ppfile,expr,TRUE);
  86.     pplevel += flatsize(expr);
  87. }
  88.  
  89. /* ppputc - output a character and update the indent level */
  90. LOCAL ppputc(ch)
  91.   int ch;
  92. {
  93.     xlputc(ppfile,ch);
  94.     pplevel++;
  95. }
  96.  
  97. /* ppterpri - terminate the print line and indent */
  98. LOCAL ppterpri()
  99. {
  100.     xlterpri(ppfile);
  101.     for (pplevel = 0; pplevel < ppmargin; pplevel++)
  102.     xlputc(ppfile,' ');
  103. }
  104.  
  105. /* flatsize - compute the flat size of an expression */
  106. LOCAL int flatsize(expr)
  107.   LVAL expr;
  108. {
  109.     xlfsize = 0;
  110.     xlprint(NIL,expr,TRUE);
  111.     return (xlfsize);
  112. }
  113.